# TODO: Add comment
# 
# Author: rogb
###############################################################################

# DF <- DiscountFactor(Sys.Date(),c("CHF","USD","EUR"),c("AAA","AA","BBB"),Sys.Date()+(0:9)*500,cbind(1*0.9^(0:9),1*0.875^(0:9),1*0.85^(0:9)))
# DF <- DiscountFactor(Sys.Date(),"CHF","AAA",Sys.Date()+(0:9)*500,1*0.9^(0:9))

# CF <- CashFlow(c("CHF","EUR"),c("AAA","BBB"),Sys.Date()+(1:5)*450,matrix(runif(10)*1000,nrow=5))
# e1 <- CF
# e2 <- DF


setMethod("-",signature=c("ZeroRateCurve","ZeroRateCurve"),function(e1,e2){
			ne1 <- dim(e1)[2]
			ne2 <- dim(e2)[2]
			if((ne1!=ne2) && (ne2>1 && ne1>1)){
				stop("Zero Rate Curves have wrong dimension")
			}
			if(situationDate(e1)!=situationDate(e2)){
				stop("Situation Dates are not equal")
			}
			SituationDate <- situationDate(e1)
			Currency <- paste("(",currency(e1),"|-|",currency(e2),")",sep="")
			Name <- paste("(",name(e1),"|-|",name(e2),")",sep="")
			Date <- sort(unique(c(getDate(e1),getDate(e2))))
			
			if(ne1==ne2){
				Data <- getData(e1[Date,]) - getData(e2[Date,])
			}
			if(ne1==1 && (ne1!=ne2)){
				Data <- as.vector(getData(e1[Date,])) - getData(e2[Date,])
			}
			if(ne2==1 && (ne1!=ne2)){
				Data <- getData(e1[Date,]) - as.vector(getData(e2[Date,]))
			}
			ZeroRateSpread(SituationDate,Currency,Name,Date,Data)
		})

setMethod("+",signature=c("ZeroRateCurve","ZeroRateSpread"),function(e1,e2){
			class(e2) <- "ZeroRateCurve"
			out <- e1 - -1*e2
			class(out) <- "ZeroRateCurve"
			info(out) <- info(e1)
			out
		})

setMethod("-",signature=c("ZeroRateCurve","ZeroRateSpread"),function(e1,e2){
			e1 + -1*e2
		})

setMethod("+",signature=c("ZeroRateSpread","ZeroRateCurve"),function(e1,e2){
			e2 + e1
		})


setMethod("+",signature=c("ZeroRateSpread","ZeroRateSpread"),function(e1,e2){
			ne1 <- dim(e1)[2]
			ne2 <- dim(e2)[2]
			if((ne1!=ne2) && (ne2>1 && ne1>1)){
				stop("Zero Rate Spreads have wrong dimension")
			}
			if(situationDate(e1)!=situationDate(e2)){
				stop("Situation Dates are not equal")
			}
			SituationDate <- situationDate(e1)
			Currency <- paste("(",currency(e1),"|+|",currency(e2),")",sep="")
			Name <- paste("(",name(e1),"|+|",name(e2),")",sep="")
			Date <- sort(unique(c(getDate(e1),getDate(e2))))
			
			if(ne1==ne2){
				Data <- getData(e1[Date,]) + getData(e2[Date,])
			}
			if(ne1==1 && (ne1!=ne2)){
				Data <- as.vector(getData(e1[Date,])) + getData(e2[Date,])
			}
			if(ne2==1 && (ne1!=ne2)){
				Data <- getData(e1[Date,]) + as.vector(getData(e2[Date,]))
			}
			ZeroRateSpread(SituationDate,Currency,Name,Date,Data)
		})

setMethod("*",signature=c("CashFlow","DiscountFactor"),function(e1,e2){
			InfoMatch <- as.numeric(sapply(info(e1),function(x,y)which(x==y),info(e2)))
			Currency <- currency(e1)
			Name <- name(e1)
			Data <- t(colSums(getData(e1) * getData(e2[getDate(e1),InfoMatch])))
			CashFlow(Currency,Name,situationDate(e2),Data)
		})

setMethod("*",signature=c("DiscountFactor","CashFlow"),function(e1,e2){
			e2 * e1
		})

setMethod("*",signature=c("ZeroRateCurve","CashFlow"),function(e1,e2){
			e2 * as(e1,"DiscountFactor")
		})

setMethod("*",signature=c("CashFlow","ZeroRateCurve"),function(e1,e2){
			e1 * as(e2,"DiscountFactor")
		})

setMethod("presentValue",signature=c("CashFlow","DiscountFactor"),function(object,arg1){
			as.numeric(getData(object * arg1))
		})

setMethod("presentValue",signature=c("CashFlow","ZeroRateCurve"),function(object,arg1){
			presentValue(object,as(arg1,"DiscountFactor"))
		})

setMethod("duration",signature=c("CashFlow","DiscountFactor"),function(object,DF){
			InfoMatch <- as.numeric(sapply(info(object),function(x,y)which(x==y),info(DF)))
			CashFlowDates <- getDate(object)
			Time <- yearFraction(situationDate(DF),CashFlowDates)
			TimeWeightedCashFlow <- getData(object) * getData(DF[CashFlowDates,InfoMatch]) * Time
			colSums(TimeWeightedCashFlow) / as.numeric(presentValue(object,DF))
		})

setMethod("duration",signature=c("CashFlow","ZeroRateCurve"),function(object,DF){
			duration(object,as(DF,"DiscountFactor"))
		})

setMethod("convexity",signature=c("CashFlow","DiscountFactor"),function(object,DF){
			InfoMatch <- as.numeric(sapply(info(object),function(x,y)which(x==y),info(DF)))
			CashFlowDates <- getDate(object)
			Time <- yearFraction(situationDate(DF),CashFlowDates)
			TimeWeightedCashFlow <- getData(object) * getData(DF[CashFlowDates,InfoMatch]) * Time^2
			colSums(TimeWeightedCashFlow) / as.numeric(presentValue(object,DF))
		})

setMethod("convexity",signature=c("CashFlow","ZeroRateCurve"),function(object,DF){
			convexity(object,as(DF,"DiscountFactor"))
		})

setMethod("dv01",signature=c("CashFlow","DiscountFactor"),function(object,arg1){
			PV <- presentValue(object,arg1)
			D <- duration(object,arg1)
			C <- convexity(object,arg1)
			(-0.0001 * D + 1/2 * 0.0001^2 * C)*PV
		})

setMethod("dv01",signature=c("CashFlow","ZeroRateCurve"),function(object,arg1){
			dv01(object,as(arg1,"DiscountFactor"))
		})

setMethod("dv01empirical",signature=c("CashFlow","ZeroRateCurve"),function(object,arg1){
			presentValue(object,arg1+0.01) - presentValue(object,arg1)
		})

setMethod("dv01empirical",signature=c("CashFlow","DiscountFactor"),function(object,arg1){
			dv01empirical(object,as(arg1,"ZeroRateCurve"))
		})

derivCashFlowIR <- function(CF,DF,Order){
	InfoMatch <- as.numeric(sapply(info(CF),function(x,y)which(x==y),info(DF)))
	CashFlowDates <- getDate(CF)
	Time <- yearFraction(situationDate(DF),CashFlowDates)
	TimeWeightedCashFlow <- (-1)^Order*getData(CF) * getData(DF[CashFlowDates,InfoMatch]) * Time^Order
	TimeWeightedCashFlow
}

derivCashFlowTime <- function(CF,DF,Order){
	InfoMatch <- as.numeric(sapply(info(CF),function(x,y)which(x==y),info(DF)))
	CashFlowDates <- getDate(CF)
	Time <- yearFraction(situationDate(DF),CashFlowDates)
	TimeWeightedCashFlow <- (-1)^Order*getData(CF) * getData(DF[CashFlowDates,InfoMatch]) * (getData(as(DF[CashFlowDates,InfoMatch],"ZeroRateCurve"))/100)^Order
	TimeWeightedCashFlow
}

# CF <- CashFlow("CHF","Swap Rate",DateYMD(2010:2030,6,15),c(rep(5,20),105))
# CF <- CashFlow("CHF","Swap Rate",plusYear(Sys.Date(),10),c(100))
# TargetDate <-DateYMD(2010:2030,6,15)[-c(4,6,7,8,9,11:20)]
# newCF <- rearrangeCashFlow(TargetDate,CF,DF,nDerivIR=3,nDerivTime=1)
# newCF1 <- rearrangeCashFlowIR(TargetDate,CF,DF,nDerivIR=1)
# TargetDate <- c(DateYMD(2019,11,30),DateYMD(2021,11,30))
# TargetDate <- Sys.Date()+(1:40)*365
# newCF <- rearrangeCashFlow(TargetDate,CF,DF,nDeriv=3)
# CF <- CashFlow("CHF","AAA",DateYMD(2020,11,30),1000)
# newCF <- rearrangeCashFlow(Sys.Date()+(1:3)*100,CF,DF,nDeriv=3)
# presentValue(newCF,DF)/presentValue(CF,DF)
# duration(newCF,DF)/duration(CF,DF)
# convexity(newCF,DF)/convexity(CF,DF)

rearrangeCashFlow <- function(TargetDate,CF,DF,nDerivIR=2,nDerivTime=1){
	# DF <- DiscountFactor(Sys.Date(),"CHF","Swap Rate",Sys.Date()+(0:9)*500,1*0.9^(0:9))
	# ZR <- as.ZeroRateCurve(DF)
	# CF <- CashFlow("CHF","Swap Rate",DateYMD(2010:2030,6,15),c(rep(5,20),105))
	# CF <- CashFlow("CHF","Swap Rate",DateYMD(2010:2030,6,15),rnorm(21)*1000)
	# TargetDate <-DateYMD(2010:2030,6,15)[-c(4,6,7,8,9,11:20)]
	# nDerivIR <- 3
	# nDerivTime <- 1
	# CF1 <- rearrangeCashFlow(TargetDate,CF,DF,nDerivIR=3,nDerivTime=1)
		
	InfoMatch <- as.numeric(sapply(info(CF),function(x,y)which(x==y),info(DF)))
	Time <- yearFraction(situationDate(DF),TargetDate)
	newDF <- getData(DF[TargetDate,InfoMatch])
	ZR <- as.ZeroRateCurve(DF)
	newZR <- getData(ZR[TargetDate,InfoMatch])
	
	nTarget <- length(TargetDate)
	nCF <- dim(CF)[2]
	nDate <- dim(CF)[1]
	
	TargetFiguresIR <- array(0,c(nDate,nCF,nDerivIR+1))
	TargetFiguresIR[] <- sapply(0:(nDerivIR),function(i,CF,DF){
				0.01^i*derivCashFlowIR(CF,DF,i)/factorial(i)
			},CF,DF)
	
	TargetFiguresTime <- array(0,c(nDate,nCF,nDerivTime+1))
	TargetFiguresTime[] <- sapply(0:(nDerivTime),function(i,CF,DF){
				derivCashFlowTime(CF,DF,i)
			},CF,DF)
	
	newMaxCashFlowIR <- matrix(min(nTarget,nDerivIR+1),ncol=nCF,nrow=nDate)
	newMaxCashFlowTime <- matrix(min(nTarget,nDerivTime),ncol=nCF,nrow=nDate)
	
	Data <- matrix(0,nrow=nTarget,ncol=nCF)
	CashFlowDate <- getDate(CF)
	DateDiff <- matrix(0,nrow=nTarget,ncol=nDate)
	DateDiff[] <- sapply(as.numeric(CashFlowDate),function(x,y)y-x,as.numeric(TargetDate))
	row.names(DateDiff) <- 1:nTarget
	
	for(i in 1:nCF){
		for(k in 1:nDate){
			# i <- 1
			# k <- 1
			# k <- k + 1
			nIR <- newMaxCashFlowIR[k,i]
			nTime <- newMaxCashFlowTime[k,i]
			
			bIR <- TargetFiguresIR[k,i,1:nIR]
			
			if(nTime>0){
				bTime <- TargetFiguresTime[k,i,2:(nTime+1)]
			}else{
				bTime <- numeric(0)
			}
			
			n <- nIR + nTime
			
			tmpDateDiff <- sort(abs(DateDiff[,k]))
			
			idxDate <- as.numeric(names(tmpDateDiff[1]))
			while(length(idxDate)<n){
				idxNext <- as.numeric(names(sort(abs(sum(DateDiff[idxDate,k]) + DateDiff[-idxDate,k]))[1]))
				idxDate <- c(idxDate,idxNext)
			}
			idxDate <- sort(idxDate)
			tmpTargetDate <- TargetDate[idxDate]
			Time <- yearFraction(situationDate(DF),tmpTargetDate)
			
			TimeMatIR <- t(matrix(Time,nrow=n,ncol=nIR))^(0:(nIR-1))* (-1)^(0:(nIR-1)) / factorial(0:(nIR-1)) * 0.01^(0:(nIR-1))
			DFMatIR <- t(matrix(newDF[idxDate,i],nrow=n,ncol=nIR))
			CoefMatIR <- TimeMatIR * DFMatIR
			
			if(nTime>0){
				# IRMatTime <- t(matrix(-log(newDF[idxDate,i])/Time,nrow=n,ncol=nTime))^(1:(nTime))* (-1)^(1:(nTime))
				IRMatTime <- t(matrix(newZR[idxDate,i]/100,nrow=n,ncol=nTime))^(1:(nTime))* (-1)^(1:(nTime))
				DFMatTime <- t(matrix(newDF[idxDate,i],nrow=n,ncol=nTime))
				CoefMatTime <- IRMatTime * DFMatTime
			}else{
				CoefMatTime <- t(matrix(0,nrow=n,ncol=nTime))
			}
			
			CoefMat <- rbind(CoefMatIR,CoefMatTime)
			b <- c(bIR,bTime)
			
			Data[idxDate,i] <- Data[idxDate,i] + solve(CoefMat,b)
		}
	}
	CashFlow(currency(CF),name(CF),TargetDate,Data)
}

rearrangeCashFlowRobust <- function(TargetDate,CF,DF,maxTargetCF=3,keepDirection=TRUE){
	# DF <- DiscountFactor(Sys.Date(),"CHF","Swap Rate",Sys.Date()+(0:9)*500,1*0.9^(0:9))
	# ZR <- as.ZeroRateCurve(DF)
	# ZR <- ZeroRateCurve(Sys.Date(),"CHF","Swap Rate",Sys.Date()+(0:9)*500,rep(5,10))
	# DF <- as.DiscountFactor(ZR)
	# CF <- CashFlow("CHF","Swap Rate",DateYMD(2010:2030,6,15),c(rep(5,20),105))
	# CF <- CashFlow("CHF","Swap Rate",DateYMD(2010:2030,6,15),runif(21)*1000)
	# TargetDate <- plusYear(Sys.Date(),c(0:5,7,10,15,20,30,40,60))
	# keepDirection=TRUE
	# maxTargetCF=3
	# CF1 <- rearrangeCashFlow(TargetDate,CF,DF,nDerivIR=1,nDerivTime=0)
	# CF2 <- rearrangeCashFlowRobust(TargetDate,CF,DF)
	# CF3 <- rearrangeCashFlowRobust(TargetDate,CF,DF,maxTargetCF=5,keepDirection=FALSE)
	# CF4 <- rearrangeCashFlow(TargetDate,CF,DF,nDerivIR=3,nDerivTime=1)
	# duration(merge(CF,CF1,CF2,CF3,CF4),DF)
	# convexity(merge(CF,CF1,CF2,CF3,CF4),DF)
	# sd(getData(merge(CF1,CF2,CF3,CF4)))
	# merge(CF1,CF2,CF3,CF4)
	# merge(CF,CF1,CF2,CF3,CF4) * ZR
	
	
	InfoMatch <- as.numeric(sapply(info(CF),function(x,y)which(x==y),info(DF)))
	Time <- yearFraction(situationDate(DF),TargetDate)
	newDF <- getData(DF[TargetDate,InfoMatch])
	ZR <- as.ZeroRateCurve(DF)
	newZR <- getData(ZR[TargetDate,InfoMatch])
	
	
	CashFlowDirection <- sign(getData(CF))
	
	nTarget <- length(TargetDate)
	nCF <- dim(CF)[2]
	nDate <- dim(CF)[1]
	
	TargetFiguresIR <- array(0,c(nDate,nCF,maxTargetCF+1))
	TargetFiguresIR[] <- sapply(0:(maxTargetCF),function(i,CF,DF){
				0.01^i*derivCashFlowIR(CF,DF,i)/factorial(i)
			},CF,DF)
	
	TargetFiguresTime <- array(0,c(nDate,nCF,maxTargetCF))
	TargetFiguresTime[] <- sapply(1:(maxTargetCF),function(i,CF,DF){
				derivCashFlowTime(CF,DF,i)
			},CF,DF)
	
	newMaxCashFlowIR <- maxTargetCF+1
	newMaxCashFlowTime <- maxTargetCF
	
	Data <- matrix(0,nrow=nTarget,ncol=nCF)
	CashFlowDate <- getDate(CF)
	
	DateDiff <- matrix(0,nrow=nTarget,ncol=nDate)
	DateDiff[] <- sapply(as.numeric(CashFlowDate),function(x,y)y-x,as.numeric(TargetDate))
	row.names(DateDiff) <- 1:nTarget
	
	for(i in 1:nCF){
		for(k in 1:nDate){
			# i <- 1
			# k <- 1
			# k <- k + 1
			nIR <- newMaxCashFlowIR
			nTime <- newMaxCashFlowTime
			
			bIR <- TargetFiguresIR[k,i,1:nIR]
			bTime <- TargetFiguresTime[k,i,1:nTime]
			
			n <- nIR + nTime
						
			tmpDateDiff <- sort(abs(DateDiff[,k]))
			
			idxDate <- as.numeric(names(tmpDateDiff[1]))
			while(length(idxDate)<maxTargetCF){
				idxNext <- as.numeric(names(sort(abs(sum(DateDiff[idxDate,k]) + DateDiff[-idxDate,k]))[1]))
				idxDate <- c(idxDate,idxNext)
			}
			idxDate <- sort(idxDate)
			
			tmpTargetDate <- TargetDate[idxDate]
			Time <- yearFraction(situationDate(DF),tmpTargetDate)
			
			TimeMatIR <- t(matrix(Time,nrow=maxTargetCF,ncol=nIR))^(0:(nIR-1))* (-1)^(0:(nIR-1)) / factorial(0:(nIR-1)) * 0.01^(0:(nIR-1))
			DFMatIR <- t(matrix(newDF[idxDate,i],nrow=maxTargetCF,ncol=nIR))
			CoefMatIR <- TimeMatIR * DFMatIR
			
			#IRMatTime <- t(matrix(-log(newDF[idxDate,i])/Time,nrow=maxTargetCF,ncol=nTime))^(1:(nTime))* (-1)^(1:(nTime))
			IRMatTime <- t(matrix(newZR[idxDate,i]/100,nrow=maxTargetCF,ncol=nTime))^(1:(nTime))* (-1)^(1:(nTime))
			DFMatTime <- t(matrix(newDF[idxDate,i],nrow=maxTargetCF,ncol=nTime))
			CoefMatTime <- IRMatTime * DFMatTime
	
			CoefMat <- rbind(CoefMatIR,CoefMatTime)
			CoefVec <- c(bIR,bTime)
			
			#idxOk <- apply(CoefMat,1,function(x)all(!is.na(x)))
			#CoefMat <- CoefMat[idxOk,]
			#CoefVec <- CoefVec[idxOk]
			
			D <- t(CoefMat) %*% CoefMat
			d <- CoefVec %*% CoefMat
			
			A <- CoefMatIR[1:2,,drop=FALSE]
			b <- bIR[1:2]
			meq <- 2
			
			if(all(DateDiff[,k]>=0) | all(DateDiff[,k]<=0)){
				A <- CoefMatIR[1,,drop=FALSE]
				b <- bIR[1]
				meq <- 1
			}
			
			
			# inequality constraints
			if(keepDirection){
				Ax <- matrix(0,nrow=maxTargetCF,ncol=maxTargetCF) 
				if(CashFlowDirection[k]>=0){
					diag(Ax) <- 1
				}else{
					diag(Ax) <- -1
				}
				A <- rbind(A,Ax)
				b <- c(b,rep(0,maxTargetCF))
			}
			
			fit <- solve.QP(D, d, t(A), b, meq=meq)
			
			Data[idxDate,i] <- Data[idxDate,i] + fit$solution
		}
	}
	CashFlow(currency(CF),name(CF),TargetDate,Data)
}


# CF1 <- rearrangeCashFlow(TargetDate,CF,DF,nDerivIR=3,nDeriv=0)

# object <- ZeroRateCurve(Sys.Date(),"CHF","Swap Rate",Sys.Date()+(0:10)*1000,runif(11)*5)
# object <- ZeroRateCurve(Sys.Date(),"CHF","Swap Rate",Sys.Date()+(0:10)*1000,rep(4,11))
# object <- ZeroRateCurve(Sys.Date(),c("CHF","EUR"),c("Swap Rate","Swap Rate"),Sys.Date()+(0:10)*1000,cbind(runif(11)*5,runif(11)*5))


# special constructors 

if(F){

swap <- read.csv("G:\\IM-InvestmentMgmt\\SLAM-SLAssetManagement\\Risk\\Risk\\MarketDataReport\\Archive\\tmp\\SwapCHF.csv",sep=";",stringsAsFactors=F)
swap <- read.csv("C:\\Users\\Roger\\Documents\\Downloads\\SwapCHF.csv",sep=";",stringsAsFactors=F)
swap <- read.csv("G:\\IM-InvestmentMgmt\\SLAM-SLAssetManagement\\Risk\\Risk\\MarketDataReport\\Archive\\tmp\\SwapCHF3.csv",sep=";",stringsAsFactors=F)

SwapRatePortfolio <- list()
for(i in 1:dim(swap)[1]){
	# i <- 1
	
	id <- regexpr("[0-9]*[0-9]",swap$TERM[i])
	Term <- as.numeric(substring(swap$TERM[i],id,attributes(id)$match.length))
	Freq <- substring(swap$TERM[i],id + attributes(id)$match.length,nchar(swap$TERM[i]))
	
	if(swap$TYPE_ID[i]==1){
		instrument <- LiborRate(Term,Freq,Rate=swap$RATE[i],"CHF","Swap Rate",Sys.Date(),"Actual/360","SWISSEXCHANGE")
		SwapRatePortfolio <- c(SwapRatePortfolio,instrument)
	}
	if(swap$TYPE_ID[i]==2){
		instrument <- LiborRateFuture(MaturityTerm=Term,MaturityFrequency=Freq,Term=3,Frequency="M",Currency="CHF",Name="Swap Rate",SituationDate=Sys.Date(),DayCountConvention="Actual/360",Exchange="SWISSEXCHANGE",Price=swap$RATE[i],UnderlyingSigma=0)
		SwapRatePortfolio <- c(SwapRatePortfolio,instrument)
	}
	
	if(swap$TYPE_ID[i]==3){
		instrument <- SwapRate(Term,swap$RATE[i],1,"CHF","Swap Rate",Sys.Date(),"30/360","SWISSEXCHANGE")
		SwapRatePortfolio <- c(SwapRatePortfolio,instrument)
	}
	
}

SwapRatePortfolio <- SwapRatePortfolio[1:4]

SwapRatePortfolio <- SwapRatePortfolio[sample(1:26,20,replace=F)]
DF <- estimateDiscountFactor(SwapRatePortfolio,omegaT=c(100,0,0))
ZR <- calculateZeroRateCurve(SwapRatePortfolio)


ZR1 <- as.ZeroRateCurve(DF)
plot(merge(ZR,ZR1)[1:12,])
plot(merge(ZR,ZR1))

}# if(F) 

# DF <- DiscountFactor(Sys.Date(),"CHF","Swap Rate",Sys.Date()+(0:9)*500,1*0.9^(0:9))
# DF <- SwapRateDiscountFactor(sw1,sw2,sw3)

calculateZeroRateCurve <- function(...){
	SwapRatePortfolio <- c(...)
	n <- length(SwapRatePortfolio)
	tmpSituationDate <- unlist(lapply(SwapRatePortfolio,situationDate))
	if(all(tmpSituationDate[1]==tmpSituationDate[-1])){
		SituationDate <- as.Date(tmpSituationDate[1],origin="1970-01-01")
	}else{
		stop("Swap Rate have unequal situation dates")
	}
	tmpCurrency <- unlist(lapply(SwapRatePortfolio,currency))
	if(all(tmpCurrency[1]==tmpCurrency[-1])){
		Currency <- tmpCurrency[1]
	}else{
		stop("Instruments have unequal situation Currency")
	}
	tmpName <- unlist(lapply(SwapRatePortfolio,name))
	if(all(tmpCurrency[1]==tmpCurrency[-1])){
		Name <- tmpName[1]
	}else{
		stop("Instruments Rate have unequal names")
	}
	
	tmpCashFlows <- lapply(SwapRatePortfolio,generateCashFlows)
		
	
	# identify bootstrapping order
	tmpMaxDate <- sapply(tmpCashFlows,function(cf)max(getDate(cf)))
	names(tmpMaxDate) <- 1:length(tmpMaxDate)
	CashFlowOrder <- as.numeric(names(sort(tmpMaxDate)))
	
	SwapCashFlow <- CashFlow(Currency,"Swap Rate",SituationDate,0)
	for(i in 1:n){
		SwapCashFlow <- merge(SwapCashFlow,tmpCashFlows[[CashFlowOrder[i]]])
	}
	SwapCashFlow <- SwapCashFlow[,-1]
		
	# bootstrap the curve...
	# first instrument
	
	CF <- generateCashFlows(SwapRatePortfolio[[CashFlowOrder[1]]])
	Date <- getDate(CF)
	nCF <- length(Date)

	f <- function(r){
		Rate <- rep(r/1000,nCF)
		ZR <- ZeroRateCurve(SituationDate,Currency,Name,Date,Rate)
		getData(as(ZR,"DiscountFactor") * CF)
	}
	r <- uniroot(f,c(0,100000))$root
	Rate <- rep(r/1000,nCF)
	ZR <- ZeroRateCurve(SituationDate,Currency,Name,Date,Rate)
	
	# the rest
	# i <- 2
	# i <- i+1
	for(i in 2:n){
		CF <- generateCashFlows(SwapRatePortfolio[[CashFlowOrder[i]]])
		Date <- getDate(CF)
	
		oldDates <- getDate(ZR)
		oldRates <- getData(ZR)
		lastDate <- max(getDate(ZR)) 
		lastRate <- getData(ZR[lastDate,])
		newDates <- Date[Date > lastDate]
		a <- 0
		f <- function(a){
			Date <- c(oldDates,newDates)
			Time <- yearFraction(lastDate,newDates)
			newRates <- lastRate + a/1000*Time
			Rate <- c(oldRates,newRates)
			ZR <- ZeroRateCurve(SituationDate,Currency,Name,Date,Rate)
			getData(as(ZR,"DiscountFactor") * CF)
		}
		fit <- uniroot(f,c(-100000,100000))
		# print(fit$f.root)
		a <- fit$root
		# print(a)
		Date <- c(oldDates,newDates)
		Time <- yearFraction(lastDate,newDates)
		newRates <- lastRate + a/1000*Time
		Rate <- c(oldRates,newRates)
		ZR <- ZeroRateCurve(SituationDate,Currency,Name,Date,Rate)
	}
	
	ZR
	
}

estimateDiscountFactor <- function(...,equality=TRUE,omegaT=c(100,0,0)){
	SwapRatePortfolio <- c(...)
	n <- length(SwapRatePortfolio)
	
	if(n==1){
		object <- SwapRatePortfolio[[1]]
		ZR <- estimateIRR(object)
		DF <- as(ZR,"DiscountFactor")
	}
	
	if(n>1){
		tmpSituationDate <- unlist(lapply(SwapRatePortfolio,situationDate))
		if(all(tmpSituationDate[1]==tmpSituationDate[-1])){
			SituationDate <- as.Date(tmpSituationDate[1],origin="1970-01-01")
		}else{
			stop("Swap Rate have unequal situation dates")
		}
		tmpCurrency <- unlist(lapply(SwapRatePortfolio,currency))
		if(all(tmpCurrency[1]==tmpCurrency[-1])){
			Currency <- tmpCurrency[1]
		}else{
			stop("Swap Rate have unequal Currency")
		}
		tmpName <- unlist(lapply(SwapRatePortfolio,name))
		if(all(tmpName[1]==tmpName[-1])){
			Name <- tmpName[1]
		}else{
			stop("Swap Rate have unequal Name")
		}
		
		
		tmpCashFlows <- lapply(SwapRatePortfolio,generateCashFlows)
		tmpPrice <- sapply(SwapRatePortfolio,price)
		SwapCashFlow <- CashFlow(Currency,"Swap Rate",SituationDate,0)
	
		for(i in 1:n){
			SwapCashFlow <- merge(SwapCashFlow,tmpCashFlows[[i]])
		}

	
		nInstruments <- dim(SwapCashFlow)[2]
		nFactor <- length(getDate(SwapCashFlow))
		Date <- getDate(SwapCashFlow)
		Time <- as.numeric(Date)
		Time <- Time - as.numeric(SituationDate)
		dTime <- diff(Time)
		#Time <- yearFraction(SituationDate,Date)
		
		# equality constraints
		meq <- n + 1
		A1 <- t(getData(SwapCashFlow))
		
		# A1[,1] <- A1[,1] + c(1,-1*tmpPrice)
		A1[,1] <- A1[,1] + c(1,rep(0,n))
		
		b1 <- c(1,rep(0,n))
		
		if(nInstruments == nFactor){
			dFactor <- solve(A1,b1)
			DF <- DiscountFactor(SituationDate,Currency,"Swap Rate",Date,dFactor)
		}
		if(nInstruments < nFactor){
			# inequality constraints 1
			A2 <- matrix(0,ncol=nFactor,nrow=nFactor)
			diag(A2) <- 1
			subMatrix <- A2[1:(nFactor-1),2:(nFactor),drop=FALSE]
			diag(subMatrix) <- -1
			A2[1:(nFactor-1),2:(nFactor)] <- subMatrix
			b2 <- rep(0,nFactor)
						
			
			A <- rbind(A1,A2)
			b <- c(b1,b2)
	
			
			# optimization 1 (take 3 points and optimize between)
			##################################################################################
	
			D1 <- matrix(0,ncol=nFactor,nrow=nFactor-2)
			omega1 <- Time[2:(nFactor-1)] / (Time[3:(nFactor)] - Time[1:(nFactor-2)])
			omega2 <- Time[1:(nFactor-2)] / (Time[3:(nFactor)] - Time[1:(nFactor-2)])
		
			subMatrix <- D1[1:(nFactor-2),1:(nFactor-2),drop=FALSE]
			diag(subMatrix) <- - omega1 + omega2 + 1
			D1[1:(nFactor-2),1:(nFactor-2)] <- subMatrix
				
			subMatrix <- D1[1:(nFactor-2),2:(nFactor-1),drop=FALSE]
			diag(subMatrix) <- -1
			D1[1:(nFactor-2),2:(nFactor-1)] <- subMatrix
	
			subMatrix <- D1[1:(nFactor-2),3:(nFactor-0),drop=FALSE]
			diag(subMatrix) <- omega1 - omega2
			D1[1:(nFactor-2),3:(nFactor-0)] <- subMatrix
			##################################################################################
			
			# optimization 2
			##################################################################################

			D21 <- matrix(0,ncol=nFactor,nrow=nFactor-3)
			omega1 <- Time[2:(nFactor-2)] / (Time[4:(nFactor)] - Time[1:(nFactor-3)])
			omega2 <- Time[1:(nFactor-3)] / (Time[4:(nFactor)] - Time[1:(nFactor-3)])
			
			subMatrix <- D21[1:(nFactor-3),1:(nFactor-3),drop=FALSE]
			diag(subMatrix) <- -omega1 + omega2 + 1
			D21[1:(nFactor-3),1:(nFactor-3)] <- subMatrix
			
			subMatrix <- D21[1:(nFactor-3),2:(nFactor-2),drop=FALSE]
			diag(subMatrix) <- -1
			D21[1:(nFactor-3),2:(nFactor-2)] <- subMatrix
			
			subMatrix <- D21[1:(nFactor-3),4:(nFactor-0),drop=FALSE]
			diag(subMatrix) <- omega1 - omega2
			D21[1:(nFactor-3),4:(nFactor-0)] <- subMatrix
			
			##################################################################################
			
			D22 <- matrix(0,ncol=nFactor,nrow=nFactor-3)
			omega1 <- Time[3:(nFactor-1)] / (Time[4:(nFactor)] - Time[1:(nFactor-3)])
			omega2 <- Time[1:(nFactor-3)] / (Time[4:(nFactor)] - Time[1:(nFactor-3)])
			
			subMatrix <- D22[1:(nFactor-3),1:(nFactor-3),drop=FALSE]
			diag(subMatrix) <- -omega1 + omega2 + 1
			D22[1:(nFactor-3),1:(nFactor-3)] <- subMatrix
			
			subMatrix <- D22[1:(nFactor-3),3:(nFactor-1),drop=FALSE]
			diag(subMatrix) <- -1
			D22[1:(nFactor-3),3:(nFactor-1)] <- subMatrix
			
			subMatrix <- D22[1:(nFactor-3),4:(nFactor-0),drop=FALSE]
			diag(subMatrix) <- omega1 - omega2
			D22[1:(nFactor-3),4:(nFactor-0)] <- subMatrix
			
			##################################################################################
			
			
			
			# Time weights
			##################################################################################

			omegaT1 <- apply(cbind((diff(Time)[1:(nFactor-2)]),(diff(Time)[2:(nFactor-1)])),1,prod)
			omegaT1 <- max(omegaT1) / omegaT1
			omegaT1 <- omegaT[1]/max(omegaT1)*omegaT1	
			
			omegaT21 <-  apply(cbind((Time[2:(nFactor-2)] - Time[1:(nFactor-3)]),(Time[4:(nFactor-0)] - Time[2:(nFactor-2)])),1,prod)
			omegaT21 <- max(omegaT21) / omegaT21
			omegaT21 <- omegaT[2]/max(omegaT21)*omegaT21
			
			omegaT22 <-  apply(cbind((Time[3:(nFactor-1)] - Time[1:(nFactor-3)]),(Time[4:(nFactor-0)] - Time[3:(nFactor-1)])),1,prod)
			omegaT22 <- max(omegaT22) / omegaT22
			omegaT22 <- omegaT[3]/max(omegaT22)*omegaT22
			
			##################################################################################
			
			
			D1t <- D1 * omegaT1
			D21t <- D21 * omegaT21
			D22t <- D22 * omegaT22
			
			Dt <- rbind(A1,D1t,D21t,D22t)
	
			D <- t(Dt) %*% Dt
			d <- rep(0,nFactor)	
			
			equalityTry <- NULL
			if(equality==TRUE){
				equalityTry <- try({
					fit <- solve.QP(D, d, t(A), b, meq=meq)
				})
			}else{
				fit <- solve.QP(D, d, t(A), b, meq=1)
			}
			
			criticalScore <- sum(exp(-1*yearFraction(SituationDate,Date)))
			
			if(class(equalityTry)=="try-error" || sum(fit$solution) < criticalScore){
				cat("Problem occured during solve.QP\n")
				cat("Currency: ", Currency, "\n", sep = "")
				cat("Name:     ", Name, "\n", sep = "")
				if (class(equalityTry) == "try-error") {
					cat("constraints are inconsistent, no solution! equality constraint turned off\n")
					fit <- solve.QP(D, d, t(A), b, meq = 1)
				}
				if (sum(fit$solution) < criticalScore){
					cat("discount factor shape was unrealistic! equality constraint turned off\n")
					fit <- solve.QP(D, d, t(A), b, meq = 1)
				}
			}
			
			dFactor <- fit$solution
			dFactor[dFactor<=0] <- min(dFactor[dFactor>0])
	
			DF <- DiscountFactor(SituationDate,Currency,Name,Date,dFactor)

		}# if(nInstruments < nFactor)
	}# if(n>1)
	DF
}



if(F){


DF <- estimateDiscountFactor(SwapRatePortfolio,omegaT=c(1000000,1000000,1000000))
ZR <- calculateZeroRateCurve(SwapRatePortfolio)	

ZR1 <- as.ZeroRateCurve(DF)
DF1 <- as.DiscountFactor(ZR)

ZR <- merge(ZR,ZR1)
DF <- merge(DF,DF1)

plot(ZR)
plot(DF)

fDF <- forwardDiscountFactor(Sys.Date()+3000,DF)
plot(as.ZeroRateCurve(fDF))



cat("Load required Libraries...")
rm(list=ls(all=TRUE))
library(RODBC)
library(sendmailR)
library(FFT)
cat("...done!\n")


DataBasePath <- "G:\\IM-InvestmentMgmt\\SLAM-SLAssetManagement\\Risk\\Risk\\MarketDataReport"
DataBasePath <- "C:\\Users\\Roger\\Desktop"
DataBaseName <- "Market_IR_DB.mdb"

DataBaseInfo <- paste(DataBasePath,DataBaseName,sep="\\")
connectionString <- paste("DSN=MS Access Database;DBQ=",DataBaseInfo,"",sep="")
cat(connectionString,"\n")
channel <- odbcDriverConnect(connection = connectionString)

CurveSummary <- sqlQuery(channel, "SELECT * FROM INPUT_SWAP_CURVE_SUMMARY",stringsAsFactors=FALSE)
TABLES <- CurveSummary$TABLE_NAME

# k <-6
Currency <- substring(TABLES[k],18,20)
table <- paste("GET_LAST_SWAP_",Currency,sep="")
swap <-  sqlQuery(channel, paste("SELECT * FROM ",table,sep=""),stringsAsFactors=FALSE)

SwapRatePortfolio <- list()

for(i in 1:dim(swap)[1]){
	# i <- 1
	
	id <- regexpr("[0-9]*[0-9]",swap$TERM[i])
	Term <- as.numeric(substring(swap$TERM[i],id,attributes(id)$match.length))
	Freq <- substring(swap$TERM[i],id + attributes(id)$match.length,nchar(swap$TERM[i]))
	Freq[Freq=="D"] <- "ON"
	if(swap$TYPE_ID[i]==1){
		instrument <- LiborRate(Term,Freq,Rate=swap$RATE[i],Currency,"Swap Rate",Sys.Date(),"Actual/360","DEFAULTEXCHANGE")
		SwapRatePortfolio <- c(SwapRatePortfolio,instrument)
	}
	if(swap$TYPE_ID[i]==2){
		instrument <- LiborRateFuture(MaturityTerm=Term,MaturityFrequency=Freq,Term=3,Frequency="M",Currency=Currency,Name="Swap Rate",SituationDate=Sys.Date(),DayCountConvention="Actual/360",Exchange="DEFAULTEXCHANGE",Price=swap$RATE[i],UnderlyingSigma=0)
		SwapRatePortfolio <- c(SwapRatePortfolio,instrument)
	}
	
	if(swap$TYPE_ID[i]==3){
		instrument <- SwapRate(Term,swap$RATE[i],swap$CPN_FREQ[i],Currency,"Swap Rate",Sys.Date(),"30/360","DEFAULTEXCHANGE")
		SwapRatePortfolio <- c(SwapRatePortfolio,instrument)
	}
	
}	

# idx <- sort(sample(1:length(SwapRatePortfolio),10,replace=F))

DF1 <- estimateDiscountFactor(SwapRatePortfolio)
ZR2 <- calculateZeroRateCurve(SwapRatePortfolio)	

ZR1 <- as.ZeroRateCurve(DF1)
DF2 <- as.DiscountFactor(ZR2)

ZR <- merge(ZR1,ZR2)
DF <- merge(DF1,DF2)

x11()
plot(ZR[1:20,])
x11()
plot(ZR)


DF1 <- estimateDiscountFactor(SwapRatePortfolio)
DF2 <- estimateDiscountFactor(SwapRatePortfolio2)

CF <- CashFlow("CHF","Swap Rate",Sys.Date()+0:1000,runif(1001)*100)
newCF <- rearrangeCashFlow(Sys.Date()+(0:10)*100,CF,DF)
CF <- merge(CF,CF)

DF <- merge(DF1,DF2)
names(DF) <- c("Swap Rate","Swap plus")
names(CF) <- c("Swap Rate","Swap plus")
plot(as.ZeroRateCurve(DF))


}





